perm filename DREDIT.F4[MSS,LCS]3 blob sn#096350 filedate 1974-04-08 generic text, type T, neo UTF8
00100		SUBROUTINE DREDIT
00200		COMMON/ED/K,NEXT,NN,NX,NY,J
00300		COMMON /RZ/RSZ,IPLT,RJB,CENTR
00400		COMMON /RC/MCLEF(200),IST(4000)
00500		COMMON/ZN/SCLEF(200,2),N
00600		COMMON/LL/LL
00700		COMMON/JJJ/JJJ
00800		EQUIVALENCE(M,SCLEF(1,2)),(KK,SCLEF(1,1))
00900		NEXTX=NEXT-1
01000	CC	IF(M)GO TO 20
01100	CC	A=STPT(SCLEF(NEXTX,1),RJB)
01200	CC	B=STPT(SCLEF(NEXTX,2),CENTR)
01300	CC	TYPE 4,NEXTX,A,B
01400		J=MCLEF(1)
01500	20	IF(K.EQ.'D')GO TO 1
01600	C  MOVE CURSOR TO INSERT POINT, TYPE CR.
01700	9	FORMAT(' SET POINT ',$)
01800		IF(JJJ.AND.JJK)GO TO 131
01900	C  FOR CONTINUING RELATIVE CHANGE
02000		IF(JJJ.EQ.0)JJK=0
02100	5	TYPE 9
02200		ACCEPT 3,L
02210	
02300		IF(L.EQ.'B'.OR.L.EQ.'N')RETURN
02400	C N OR B=BACKUP, J=INSERT OR ALTER TO JUMP, C=ALTER JUMP TO CONT.
02500		IF(L.EQ.' ')GO TO 12
02510		IF(L.NE.'F')GO TO 50
02520		MCLEF(NEXT-1)=MCLEF(NEXT-1)+200000000
02530		RETURN
02540	C ABOVE SET NEW FILL POINT.
02600	50	REREAD 33,ML,MLA
02700		IF(JJJ)JJK=-1
02800	C TO SET POINT BY NUM(NOT FOR FILLER)	NOT NOW IN!
02900	131	IF(M.GE.0)CALL UNPACK(NEXTX,NX,NY,MCLEF)
03100	C  FOR RELATIVE POS. CHANGE
03200		X=NX+ML
03300		Y=NY+MLA
03400		GO TO 13
03500	12	CALL RDCUR(NX,NY)
03600	130	X=STPT(FLOAT(NX),RJB)
03700		Y=STPT(FLOAT(NY),CENTR)
03800	13	NX=GTPT(X,RJB)
03900		NY=GTPT(Y,CENTR)
04000		CALL SETCUR(NX,NY,0)
04100		IF(K.EQ.0)GO TO 14
04200		NT=NEXT
04300		L=NT
04400	CC	IF(M)L=L-1
04500	C FOR FILL-EDIT
04600	40	FORMAT(' POINT OK? (Y,N,B,J,F OR C) ',$)
04650	C Y=YES,N=NO,B=BACKUP,J=JUMP,F=START FILL,C=CONTINUE(NULLIFY JUMP)
04700		TYPE 4,L,X,Y
04800		TYPE 40
04900		ACCEPT 3,L
05000		IF(L.EQ.'N')GO TO 5
05100		IF(K.NE.'A')GO TO 8
05150	C  WHAT IS ABOVE FOR?????
05200		NT=NEXTX
05300		GO TO 7
05400	11	FORMAT(I3,')',2I6,1X$)
05500	CC8	IF(M)GO TO 7
05600	8	TYPE 19
05700		ACCEPT 3,L
05800		IF(L.EQ.'B')RETURN
05900		A=X
06000		B=Y
06100		K=0
06200		GO TO 12
06300	C NOW ASSUMES → IF NO ← POINT FOUND
06400	14	IF(NX.EQ.SCLEF(NT-2,1).AND.NY.EQ.SCLEF(NT-2,2))NT=NT-1
06500	15	X=A
06600		Y=B
06700		J=J+1
06800		DO 6 L=J,NT+1,-1
06900	6	MCLEF(L)=MCLEF(L-1)
07000	7	LL=0
07100		NX=X
07200		NY=Y
07300	CC	IF(M.EQ.-1)RETURN
07400	C  -1=GO BACK TO FILL-EDITOR
07500		IF(MCLEF(NT).GT.100000000.AND.L.NE.'C')LL=(MCLEF(NT)/100000000)*
07512		1 100000000
07525		IF(L.EQ.'J')LL=100000000
07530		IF(L.EQ.'F')LL=200000000
07600		K=MCLEF(NT)
07700		CALL REPACK(NT,NX,NY,MCLEF)
07900		GO TO 100
08000	19	FORMAT(' OTHER POINT? ',$)
08100	3	FORMAT(A1)
08200	33	FORMAT(2I)
08300	4	FORMAT(I4,')',2F6.0)
08400	C  NT IS FOR INSERTS
08450	1	IF(J-NEXT)RETURN
08500		DO 10 L=NEXT,J+1
08530		IF(L.EQ.'F')LL=200000000
08600	10	MCLEF(L-1)=MCLEF(L)
08700		J=J-1
08800	100	MCLEF(1)=J
08900		KK=0
09000		IF(MCLEF(2).LT.100000000)MCLEF(2)=MCLEF(2)+100000000
09100		CALL DPYSET(1,IST,4000)
09200		CALL DPYBRT(5)
09300		KK=1
09400		CALL RDRAW(2,MCLEF(1),MCLEF,RJB,CENTR)
09500		RETURN
09600	2	CALL RDCUR(NX,NY)
09700		END
09800	
09900	C*******************************************************
10000		FUNCTION STPT(A,X)
10100		COMMON /RZ/RSZ,IPLT,RJB,CENTR
10200		R=.5
10300		Q=A/RSZ-X
10400		IF(Q)R=-R
10500		STPT=IFIX(Q+R)
10600		RETURN
10700		END
10800	
10900		FUNCTION GTPT(A,X)
11000		COMMON /RZ/RSZ,IPLT,RJB,CENTR
11100		GTPT=(A+X)*RSZ
12400		END